Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/danvbp/stindex.frm

Visual Basic Form | 1994-04-28 | 23.8 KB | 604 lines

VERSION 2.00
Begin Form Indexer
   BackColor       =   &H00C0C0C0&
   Caption         =   "Stock Indexer"
   ClientHeight    =   4905
   ClientLeft      =   1095
   ClientTop       =   1785
   ClientWidth     =   8565
   Height          =   5595
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   4905
   ScaleWidth      =   8565
   Top             =   1155
   Width           =   8685
   Begin Timer tmr_Background
      Enabled         =   0   'False
      Interval        =   2
      Left            =   8040
      Top             =   2640
   End
   Begin CommandButton cmd_Draw
      Caption         =   "Draw"
      Height          =   435
      Left            =   6780
      TabIndex        =   14
      Top             =   2640
      Width           =   1035
   End
   Begin Frame Frame1
      BackColor       =   &H00FFFF00&
      Caption         =   "Display Characteristic"
      Height          =   1635
      Left            =   4740
      TabIndex        =   11
      Top             =   3240
      Width           =   3735
      Begin Label lbl_DisplayState
         BackStyle       =   0  'Transparent
         Caption         =   "State Machine Off"
         Height          =   615
         Left            =   60
         TabIndex        =   13
         Top             =   960
         Width           =   3615
      End
      Begin Label lbl_DisplayChar
         BackColor       =   &H00FFFF00&
         Height          =   555
         Left            =   60
         TabIndex        =   12
         Top             =   300
         Width           =   3615
      End
   End
   Begin ListBox lst_Companies
      Height          =   2370
      Left            =   6240
      MultiSelect     =   2  'Extended
      TabIndex        =   10
      Top             =   180
      Width           =   2115
   End
   Begin OptionButton opt_CurIndex
      BackColor       =   &H00C0C0C0&
      Caption         =   "Index8"
      ForeColor       =   &H00FFFFFF&
      Height          =   315
      Index           =   7
      Left            =   4740
      TabIndex        =   2
      Top             =   2700
      Width           =   1335
   End
   Begin OptionButton opt_CurIndex
      BackColor       =   &H00C0C0C0&
      Caption         =   "Index7"
      ForeColor       =   &H00FFFFFF&
      Height          =   315
      Index           =   6
      Left            =   4740
      TabIndex        =   9
      Top             =   2340
      Width           =   1335
   End
   Begin OptionButton opt_CurIndex
      BackColor       =   &H00C0C0C0&
      Caption         =   "Index6"
      ForeColor       =   &H00FFFFFF&
      Height          =   315
      Index           =   5
      Left            =   4740
      TabIndex        =   8
      Top             =   1980
      Width           =   1335
   End
   Begin OptionButton opt_CurIndex
      BackColor       =   &H00C0C0C0&
      Caption         =   "Index5"
      ForeColor       =   &H00FFFFFF&
      Height          =   315
      Index           =   4
      Left            =   4740
      TabIndex        =   7
      Top             =   1620
      Width           =   1335
   End
   Begin OptionButton opt_CurIndex
      BackColor       =   &H00C0C0C0&
      Caption         =   "Index4"
      ForeColor       =   &H00FFFFFF&
      Height          =   315
      Index           =   3
      Left            =   4740
      TabIndex        =   6
      Top             =   1260
      Width           =   1335
   End
   Begin OptionButton opt_CurIndex
      BackColor       =   &H00C0C0C0&
      Caption         =   "Index3"
      ForeColor       =   &H00FFFFFF&
      Height          =   315
      Index           =   2
      Left            =   4740
      TabIndex        =   5
      Top             =   900
      Width           =   1335
   End
   Begin OptionButton opt_CurIndex
      BackColor       =   &H00C0C0C0&
      Caption         =   "Index2"
      ForeColor       =   &H00FFFFFF&
      Height          =   315
      Index           =   1
      Left            =   4740
      TabIndex        =   4
      Top             =   540
      Width           =   1335
   End
   Begin OptionButton opt_CurIndex
      BackColor       =   &H00C0C0C0&
      Caption         =   "Index1"
      ForeColor       =   &H00FFFFFF&
      Height          =   315
      Index           =   0
      Left            =   4740
      TabIndex        =   3
      Top             =   180
      Value           =   -1  'True
      Width           =   1335
   End
   Begin PictureBox pic_Display
      Height          =   4515
      Left            =   60
      ScaleHeight     =   4485
      ScaleMode       =   0  'User
      ScaleWidth      =   4485
      TabIndex        =   0
      Top             =   360
      Width           =   4515
   End
   Begin Label Label1
      BackStyle       =   0  'Transparent
      Caption         =   "Historical Data"
      Height          =   195
      Left            =   60
      TabIndex        =   1
      Top             =   60
      Width           =   2475
   End
   Begin Menu mnu_Behave
      Caption         =   "Category"
      Begin Menu mnu_Category
         Caption         =   "Non-Interruptable"
         Checked         =   -1  'True
         Index           =   0
      End
      Begin Menu mnu_Category
         Caption         =   "Background Display Only"
         Index           =   1
      End
      Begin Menu mnu_Category
         Caption         =   "Background Display and Scaling"
         Index           =   2
      End
   End
Option Explicit
Dim CurrentStateMachine%   ' Indicates which state machine is currently selected.
                        ' 0 = Non-interruptable
                        ' 1 = Background display
                        ' 2 = Background display and scaling
Dim CurrentSelectedIndex%   ' Index that is currently selected for editing.
Dim Sheet As Object     ' Object will refer to Excel sheet
                        ' containing stock prices.
Dim Companies As Object ' Object refers to an Excel range
                        ' containing the list of companies.
Dim period As Object    ' Object refers to an Excel range
                        ' containing the periods for which
                        ' we have data.
Dim HighRange As Object, LowRange As Object ' Range information
Dim DataTable As Object ' Object refers to an Excel range
                        ' containing all of the data for all
                        ' of the companies.
Dim IndexList$()    ' Brute force array of companies in
                        ' each index.
' Used for fast listbox update
Const WM_USER = &H400
Const LB_FINDSTRINGEXACT = (WM_USER + 35)
Const LB_SELITEMRANGE = (WM_USER + 28)
Declare Function SendMessage& Lib "User" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, lParam As Any)
Declare Function SendMessageBynum& Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam&)
Declare Function SendMessageBystring& Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam$)
Sub cmd_Draw_Click ()
    Dim i%, di%
    pic_Display.Cls
    LoadIndexFromList CurrentSelectedIndex
    For i% = 0 To 7
        di% = DrawIndex(i%, True)
    Next i%
End Sub
' This function draws the historical chart of an entire index.
' restart% is set to True to clear the current operation
' Returns True if the operation is completed, 0 if the function
' needs to be called again.
' See article text for additional information on this function
Function DrawIndex% (IndexNum%, restart%)
    Dim CurEntry%
    Dim IVal#
    Dim PrevVal#
    Static StateCurEntry%(7)
    Static StatePrevVal#(7)
    If restart% Then
        StateCurEntry%(IndexNum%) = 1
        If CurrentStateMachine% <> 0 Then
            ' We defined the function to always return
            ' immediately on reset.
            DrawIndex = False
            Exit Function
        End If
    End If
    If IndexList$(IndexNum%, 0) = "" Then
        ' Exit if no entries for this index
        DrawIndex% = True
        Exit Function
    End If
    Select Case CurrentStateMachine%
        Case 0 ' - Non interruptable - VERY SLOW
            For CurEntry% = 1 To period.Columns.Count
                IVal# = GetIndexVal(IndexNum%, CurEntry%)
                ' Don't draw the first entry
                If CurEntry% <> 1 Then pic_Display.Line (CurEntry% - 1, PrevVal#)-(CurEntry%, IVal#), opt_CurIndex(IndexNum%).BackColor
                PrevVal# = IVal#
            Next CurEntry%
            DrawIndex% = True
        Case 1 To 2 ' Interruptable
            If StateCurEntry%(IndexNum%) > period.Columns.Count Then
                DrawIndex% = True
                Exit Function
            End If
            IVal# = GetIndexVal(IndexNum%, StateCurEntry%(IndexNum%))
            ' Don't draw the first entry
            If StateCurEntry%(IndexNum%) <> 1 Then pic_Display.Line (StateCurEntry%(IndexNum%) - 1, StatePrevVal#(IndexNum%))-(StateCurEntry%(IndexNum%), IVal#), opt_CurIndex(IndexNum%).BackColor
            StatePrevVal#(IndexNum%) = IVal#
            StateCurEntry%(IndexNum%) = StateCurEntry%(IndexNum%) + 1
            DrawIndex% = False
    End Select
End Function
Sub Form_Load ()
    Dim col%, usecol&
    Dim rcount%
    Dim di%
    Screen.MousePointer = 11
    ' Initialize the background colors to indicate which
    ' option button corresponds to each index.
    For col% = 0 To 7
        Select Case col%
            Case 0 To 6
                usecol& = QBColor(col%)
            Case 7  ' We're drawing on a white background
                usecol& = QBColor(8)
        End Select
        opt_CurIndex(col%).BackColor = usecol&
    Next col%
    mnu_Category_Click (0)  ' Initialize menu
    ' Initialize OLE Automation objects
    Set Sheet = GetObject(app.Path & "\Stocks.XLS")
    Set Companies = Sheet.Range("companies")
    Set period = Sheet.Range("period")
    Set HighRange = Sheet.Range("highprice")
    Set LowRange = Sheet.Range("lowprice")
    Set DataTable = Sheet.Range("StockData")
    ' Now load listbox lst_Companies with a list of all
    ' available companies.  Note that this particular stock
    ' database is entirely ficitional.
    For rcount% = 1 To Companies.Rows.Count
        lst_Companies.AddItem Companies.Cells(rcount%, 1).Text
    Next rcount%
    ' Redimension list to hold all companies if necessary
    ReDim IndexList$(8, Companies.Rows.Count - 1)
    CurrentSelectedIndex% = 0   ' Track current index
    Screen.MousePointer = 0
    StateMachineInput "FormLoaded"
End Sub
' Retreives the value of an index. It searches through all
' of the companies that comprise the index and takes the
' average of their prices (Note that real stock indexes
' often use different formulas).
Function GetIndexVal# (ByVal IndexNum%, Entrynum%)
    Dim CurVal%
    Dim Comp$
    Dim dl&
    Dim TotalPrice#
    Do
        Comp$ = IndexList$(IndexNum%, CurVal%)
        If Comp$ <> "" Then
            ' Find the offset to the company
            dl& = SendMessageBystring(lst_Companies.hWnd, LB_FINDSTRINGEXACT, -1, Comp$)
            If dl& < 0 Then Exit Do ' Should never happen

            ' Now get the data for the specified entry
            TotalPrice# = TotalPrice# + DataTable.Value(dl& + 1, Entrynum%)
            CurVal% = CurVal% + 1
        End If
    Loop While Comp$ <> ""
    If CurVal% > 0 Then GetIndexVal# = TotalPrice# / CurVal%
End Function
' Retrieves the low and high range for a particular company
Sub GetPeriodLimit (ByVal Company$, LowPrice#, HighPrice#)
    Dim quote As Object
    Dim dl&
    dl& = SendMessageBystring(lst_Companies.hWnd, LB_FINDSTRINGEXACT, -1, Company$)
    If dl& >= 0 Then ' We found it, now select it
        HighPrice# = HighRange.Value(dl& + 1)
        LowPrice# = LowRange.Value(dl& + 1)
    End If
End Sub
' Loads the company list for an index from the list box
Sub LoadIndexFromList (idxnum%)
    Dim c%, CurEntry%
    For c% = 0 To lst_Companies.ListCount - 1
        If lst_Companies.Selected(c%) Then
            IndexList$(idxnum%, CurEntry%) = lst_Companies.List(c%)
            CurEntry% = CurEntry% + 1
        End If
    Next c%
    ' Clear the rest of the entries
    While CurEntry% < UBound(IndexList$, 1)
        IndexList$(idxnum%, CurEntry%) = ""
        CurEntry% = CurEntry% + 1
    Wend

End Sub
' Loads the company list box from an index list
Sub LoadListFromIndex (idxnum%)
    Dim dl&
    Dim c%
    Dim rng&
    ' First clear all existing selections
    rng& = lst_Companies.ListCount - 1
    rng& = rng * &H10000    ' Shift to high word
    dl& = SendMessageBynum(lst_Companies.hWnd, LB_SELITEMRANGE, 0, rng)
    ' Now loop through the list
    For c% = 0 To UBound(IndexList, 1)
        If IndexList$(idxnum%, c%) = "" Then Exit For' We're done
        dl& = SendMessageBystring(lst_Companies.hWnd, LB_FINDSTRINGEXACT, -1, IndexList(idxnum%, c%))
        If dl& >= 0 Then ' We found it, now select it
            lst_Companies.Selected(dl&) = True
        End If
    Next c%
End Sub
Sub lst_Companies_Click ()
    StateMachineInput "ListClicked"
End Sub
Sub mnu_Category_Click (Index As Integer)
    Dim lbl$
    Dim midx%
    For midx% = 0 To 1  ' Uncheck the other categories
        If midx% <> Index Then mnu_Category(midx%).Checked = False Else mnu_Category(midx%).Checked = True
    Next midx%
    Select Case Index
        Case 0  ' Display is non-interruptable
                ' This represents the category of task that
                ' must not allow any user interaction or changes
                ' by other applications.  It also represents
                ' non-event driven design.
                lbl$ = "Non-interruptable: Characteristic of non-event driven design."
                ' We need a command button to provide any
                ' sort of decent performance
                cmd_Draw.Visible = True
        Case 1  ' Display takes place in the background
                ' Display is retriggered on click on option button
                cmd_Draw.Visible = False
                lbl$ = "Background display: Reset on option click"
                CurrentStateMachine% = 1
        Case 2
                cmd_Draw.Visible = False
                lbl$ = "Background display and scale: Reset on option click"
                CurrentStateMachine% = 2
    End Select
    lbl_DisplayChar = lbl$
    StateMachineInput "MenuClick"
End Sub
Sub opt_CurIndex_Click (Index As Integer)
    ' Exit if no change to index
    If CurrentSelectedIndex% = Index Then Exit Sub
    ' Save previous index information
    LoadIndexFromList CurrentSelectedIndex
    LoadListFromIndex Index
    CurrentSelectedIndex% = Index
    ' Now trigger any background operations that
    ' may be necessary
    StateMachineInput "OptionClicked"
End Sub
' Sets the scale of the display area to match the period
' range and the low and high price
' restart% is set to True to reset the operation
' Returns -1 if the operation was completed, 0 if the
' function needs to be called again.
Function SetDisplayScales% (restart%)
    Dim LowPrice#, HighPrice#
    Dim LowestPrice#, HighestPrice#
    Static StateLowestPrice#, StateHighestPrice#
    Static StateC%
    ' The period width is easy: We'll use a coordinate
    ' system corresponding to the number of periods
    ' The vertical ($) axis is scaled from the lowest
    ' price to the highest.  How we do this depends on
    ' the selected Category
    Select Case CurrentStateMachine%
        ' - Non interruptable - VERY SLOW!!!
        Case 0, 1' Machine # 1 does this non-interruptable also
            Dim c%
            For c% = 0 To lst_Companies.ListCount - 1
                GetPeriodLimit ByVal lst_Companies.List(c%), LowPrice#, HighPrice#
                If c% = 0 Then
                    LowestPrice# = LowPrice#
                    HighestPrice# = HighPrice#
                Else
                    If LowPrice# < LowestPrice# Then LowestPrice# = LowPrice#
                    If HighPrice# > HighestPrice# Then HighestPrice# = HighPrice#
                End If
            Next c%
            pic_Display.Scale (0, HighestPrice#)-(period.Columns.Count, LowestPrice#)
            ' Using this algorithm we are always done
            SetDisplayScales% = True
        Case 2 ' Machine # 2 does this interruptable also
            If restart% Then
                StateC% = 0
                SetDisplayScales% = False
                Exit Function
            End If
            If StateC% > lst_Companies.ListCount - 1 Then
                pic_Display.Scale (0, StateHighestPrice#)-(period.Columns.Count, StateLowestPrice#)
                ' Using this algorithm we are always done
                SetDisplayScales% = True
                Exit Function
            End If

            GetPeriodLimit ByVal lst_Companies.List(StateC%), LowPrice#, HighPrice#
            If StateC% = 0 Then
                StateLowestPrice# = LowPrice#
                StateHighestPrice# = HighPrice#
            Else
                If LowPrice# < StateLowestPrice# Then StateLowestPrice# = LowPrice#
                If HighPrice# > StateHighestPrice# Then StateHighestPrice# = HighPrice#
            End If
            StateC% = StateC% + 1

    End Select
End Function
' This is the control function that decides what should
' be happening at any given time.
' We're using a string to describe the event for illustration
' purposes.  A real program would use an integer for efficiency.
' This is the state machine function that is the heart
' of the background processing capability.
Sub StateMachineInput (OutsideEvent$)
    Static InternalState%   ' Indicates the current state
    ' 0 - State machine off
    ' 1 - Machine is idle
    ' 2 - State machine is ready to start drawing
    ' 3 - State machine is drawing index InternalIndex%
    ' 4 - State machine is setting scale mode
    Static InternalIndex%   ' Current index being drawn (Machine 1)
    Dim result%
    ' Each of these cases defines a different state
    ' machine.
    Select Case CurrentStateMachine%
        Case 0 ' Non-interruptable.  This is not really
                ' a state machine - it just performs
                ' the specified operation immediately
            Select Case OutsideEvent$
                Case "FormLoaded"
                        result% = SetDisplayScales(True)
                Case "MenuClicked"
                        ' Turn off the state machine
                        tmr_Background.Enabled = False
                        cmd_Draw_Click
                        InternalState% = 0
                        lbl_DisplayState.Caption = "State Machine Off"
                        pic_Display.Cls
            End Select
        Case 1  ' Background display only (No state 4)
            If OutsideEvent$ = "FormLoaded" Then
                ' We're not handling display as part of
                ' the machine at this point
                result% = SetDisplayScales(True)
            End If
            Select Case InternalState%
                Case 0  ' Always turn on the machine
                        tmr_Background.Enabled = True
                        InternalState% = 2
                        lbl_DisplayState.Caption = "Start Drawing"
                        pic_Display.Cls
                Case 1  ' Idle
                    Select Case OutsideEvent$
                        Case "OptionClicked"
                            InternalState% = 2
                            lbl_DisplayState.Caption = "Start Drawing"
                    End Select
                Case 2  ' Start drawing here
                    InternalIndex% = 0
                    pic_Display.Cls
                    result% = DrawIndex(InternalIndex%, True)
                    InternalState% = 3
                    lbl_DisplayState.Caption = "Drawing in Progress"
                Case 3
                    Select Case OutsideEvent$
                        Case "OptionClicked" ' Restart
                            InternalState% = 2
                            lbl_DisplayState.Caption = "Start Drawing"
                        Case "Timer"
                            result% = DrawIndex(InternalIndex%, False)
                            If result% Then ' End of index
                                If InternalIndex% >= 7 Then
                                    InternalState% = 1 ' Goto idle
                                    lbl_DisplayState.Caption = "Idle"
                                Else
                                    InternalIndex% = InternalIndex + 1
                                    result% = DrawIndex(InternalIndex%, True)
                                End If
                            End If
                    End Select
            End Select
        Case 2  ' Background display and Scale Mode
            Select Case InternalState%
                Case 0  ' Always turn on the machine
                        tmr_Background.Enabled = True
                        InternalState% = 4
                        result% = SetDisplayScales(True)
                        lbl_DisplayState.Caption = "Setting Display Scale"
                        pic_Display.Cls
                Case 1  ' Idle
                    Select Case OutsideEvent$
                        Case "OptionClicked"
                            InternalState% = 2
                            lbl_DisplayState.Caption = "Start Drawing"
                    End Select
                Case 2  ' Start drawing here
                    InternalIndex% = 0
                    pic_Display.Cls
                    ' We've also changed the drawing algorithm
                    For InternalIndex% = 0 To 7
                        result% = DrawIndex(InternalIndex%, True)
                    Next InternalIndex%
                    InternalState% = 3
                    lbl_DisplayState.Caption = "Drawing in Progress"
                Case 3
                    Select Case OutsideEvent$
                        Case "OptionClicked" ' Restart
                            InternalState% = 2
                            lbl_DisplayState.Caption = "Start Drawing"
                        Case "Timer"
                            result% = True
                            For InternalIndex% = 0 To 7
                                ' Look for all of them to finish
                                result% = result% And DrawIndex(InternalIndex%, False)
                            Next InternalIndex%
                            If result% Then ' End of index
                                InternalState% = 1 ' Goto idle
                                lbl_DisplayState.Caption = "Idle"
                            End If
                    End Select
                Case 4
                    ' Note that the only way to exit this state is
                    ' through completion, or if you change state machines
                    ' using the menu
                    result% = SetDisplayScales(False)

                    If result% Then
                        ' Lets start a drawing operation
                        InternalState% = 2
                        lbl_DisplayState.Caption = "Start Drawing"
                        tmr_Background.Interval = 2
                    End If
            End Select

    End Select
End Sub
Sub tmr_Background_Timer ()
    StateMachineInput "Timer"
End Sub